home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacTech 1 to 12
/
MacTech-vol-1-12.toast
/
Tools
/
Alpha 6.51b13 ƒ
/
Tcl
/
SystemCode
/
clips.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
1KB
|
43 lines
#=============================================================================
# Named Clipboards
#=============================================================================
proc copyNamedClipboard {} {
global clipBoards
global pasteItemNum
set text [getText [getPos] [selEnd]]
if {![catch {prompt {Clip name?} [lindex $text 0]} name]} then {
set clipBoards($name) $text
enableMenuItem "NamedClipboards" "paste" on
}
}
proc cutNamedClipboard {} {
global clipBoards
global pasteItemNum
set text [getSelect]
if {![catch {prompt {Clip name?} [lindex $text 0]} name]} then {
deleteText [getPos] [selEnd]
set clipBoards($name) $text
enableMenuItem "NamedClipboards" "paste" on
}
}
proc pasteNamedClipboard {} {
global clipBoards
set ind [array startsearch clipBoards]
set res [array nextelement clipBoards $ind]
array donesearch clipBoards $ind
if {![catch {eval prompt {{Clip name?}} "$res" Clips [array names clipBoards]} name]} then {
if {[catch {set text $clipBoards($name)}]} then {
alertnote "No such clipboard."
return
}
if {[getSelect] == "" } then {
insertText $text
} else {
replaceText [getPos] [selEnd] $text
}
}
}